SUBROUTINE BMX(RA)
C  RA=NUMB. OF TAILS
C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
       common /XRN/RN(1) /RNW/RNW /A2Z/LAA,LBB
     1 /dpymem/R(15,150),rpos(2,100),POSNT(150),RHY(100),jstdir(150)
     1 ,ntptr(150)
     1 /RMOD/staff,SET4,IBEAM,NOSET,STEM,JSTUP,NTC,PS2,IZ,JSTEM,
     1 IRHY,POSB /ALF/INP(100) /LIMIT/LIMIT,ITEM,LL,IRN,IX
     1 /mode/mode,jm,ioct,mm,nn,motend,ichd /v/kv,v(150)
       COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /STF/RSTFAC(8),RSTJ2
     1 /RNW/RNW
        M=IRN-12
        RX7=RN(7+M)
C ORIGINAL STEM DIR. AND NUM. OF BEAMS INFO.
        DO 1 L=KN,K
        B=R(7,L)
        JB=B/10
        B=B-JB*10
        IF(R(8,L).EQ.1000.)B=0.
C AVOIDS GRACE NOTES AND NON-NOTES
CCCCC   IF(R(9,L).GE.64.)B=0
C 64"+ = NEW GRACE NOTES 6/85
        IF(R(4,K).GT.80.)B=0.
C GRACE NOTES CAN BE FROM 80 (=-120) TO 180
        IF(R(1,L).NE.1.)B=0.
1       VQ(L)=B
        VQ(K+1)=0.
C   CLEARS IT FOR ROUTINE AT '3'
        JB=KN
        RX8=0.
        JBX=0
C THE ABOVE 2 ARE FOR NEW COMPOSITE BEAM FEATURE 5/78

6       DIS=0.
        RB9=0.
        DO 2 L=JB,K
        IF(VQ(L).LE.RA)GO TO 2
C  SKIP IF EQ. TO PRESENT BEAM
        RB=VQ(L)
        LL=L
4       DO 11 JD=LL,K
        VQX = VQ(JD)
        IF(VQX.GE.RB)GO TO 20
        IF(VQX.EQ.0.)GO TO 11
C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
21      B=10.
        IF(LL.GT.KN)GO TO 13
        GO TO 16
20      JV=JD
        IF(VQX.GT.RB)GO TO 21
11      JW=JD
        B=20.
C  FINDS NEED FOR BEAM TO LEFT 
16      B=B+RA
        IF(JBX.LT.0)GO TO 50
C  FOR NEW COMPOSITE BEAM FEATURE 5/78
        JE=RN(7+M)/10.
        RN(7+M)=JE*10.+RA
        GO TO 51
50      DO 5 JE=1,6
5       RN(JE+IRN)=RN(JE+M)
        RN(7+IRN)=RX7+RB-RA*2.
C  ADDS RIGHT NUM. OF BEAMS
51      IF(LL.NE.JV)GO TO 10
        IF(LL.EQ.KN)GO TO 377
        IF(LL.NE.K)GO TO 10
377     B=-B
C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
        GO TO 8
13      IF(JV.GT.LL)GO TO 14
        IF(R(7,LL+1).LT.10)GO TO 15
C NEXT FOR DOT ON FOLLOWING NOTE.
        DIS=10.
        GO TO 19
15      DIS=20.
C SHORT INNER BEAM TO LEFT OF STEM
19      B=-RA
        GO TO 16
14      DIS=30.
C  LONG INNER BEAM
        JV=-JV
        GO TO 16

C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
10      IF(LL.EQ.KN)GO TO 22
        IF(JV.GE.0)GO TO 17
        B=R(3,LL)
        JV=-JV
        LL=JV
22      IF(VQ(JW+1).GT.VQ(JW))GO TO 17
        VQ(JW)=VQ(JW+1)
        JW=JW-1
17      IF(LL.NE.JB)GO TO 18
        IF(B.LT.20.)LL=JV
C PUTS BEAMS IN RIGHT PLACE.
18      RC=R(10,LL)
        IF(RC.EQ.0.)GO TO 23
        RB=RNW*RSTJ2
        IF(ABS(R(4,LL)).GE.100.)RB=RB*.6
C  GET WIDTH OF NOTE(RNW) FOR DISPLACEMENT
        IF(RC.EQ.2.)RB=-RB
        RC=RB
23      RB9=RC+R(3,LL)
C  THIS WILL BE POS.3
        DIS=RA+DIS
C  DISPLACES
        GO TO 8
2       CONTINUE
        RETURN
8       JB=JW+1
C  FINDS SIDE (L,R) FOR PARTIAL BEAM
C  FOR NEW DISPLACEMENT
        RN(IRN+11)=-1.
        IF(RB9+DIS.EQ.0.)GO TO 31
        IF(DIS.LT.10.)GO TO 32
        IF(DIS.LT.30.)GO TO 33
C INNER PARTIAL BEAM IS NEXT
        DIS=DIS-30.
        GO TO 31
32      IF(B.GE.20.)GO TO 12
        DIS=B-10.
        B=-1.
C  -1 PICKS UP POS OF P3
        GO TO 31
12      DIS=B-20.
        B=RB9
        RB9=-1.
C  -1 IN P9 WILL PICK UP POS OF P6
C  INNER BEAM ATTACHED TO LFT SIDE.
        GO TO 31
33      B=-DIS
        DIS=0.
31      L=IS
        IF(JBX.LT.0)GO TO 53
        L=M
C CHANGED 5/84 FOR NEG P10 FOR COMPOSITES       DIS=(RB-RA)*100.+1.
        DIS=-(RB-RA)*100.
53      IF(RX8.GT.1.)GO TO 52
        IF(RB9.NE.0.)GO TO 52
        IF(RX8.NE.0.)GO TO 54
        RX8=B
        GO TO 52
54      RN(8+M)=-30.
C TWO UNATTACHED BEAMS, LEFT AND RIGHT
        RX8=1.
        GO TO 55
52      RN(8+L)=B
        RN(9+L)=RB9
        RN(10+L)=DIS
        IF(JBX.LT.0)CALL UPDATE(9)
C  ADDED ANOTHER ITEM (PART. BEAM)
        JBX=-1
        JA=0
55      IF(JB.LE.K)GO TO 6
        END

        subroutine bauto(j,l,k,n)
        common /v/kv,v(150)
        j=j+2
        ll=l-n
        kk=k-n
        v(j-1)=ll
        end

        subroutine update(i)
       common /XRN/RN(1) /LIMIT/LIMIT,ITEM,LL,IRN,IX
        rn(irn)=i
        irn=irn+i
c i=wd cnt of this item.  Use with BEAMZ and SLURZ.
        end
 
 
        subroutine stupdn(jstm,n,rnum,a,np,hgt,grc)
c jstm=stem dir, n=note num, rnum=num over beam, a=note num, np=pointer
c hgt=height of note, grc=grace note?
        common /dpymem/R(15,150),rpos(2,100),POSNT(150),RHY(100)
     1 ,jstdir(150),ntptr(150)
 
        k=a
        n=iabs(mod(k,1000))
 c the note number
        m=jstdir(n)
        if(m.ge.0)go to 1
        jstm=-m
c get the stem direction if it was set because of chord setup
        go to 2
1       jstm=m
c get stem direction from NOTEIN if it was specified
        if(k.lt.0)jstm=20
c neg. value in current input makes stem down
        if(k.gt.1000)jstm=10
c >1000 in input forces stem up
2       rnum=10.*abs(amod(a,1.))
c for number over beam -- 12.3 or -5.3, etc. produces a 3
        np=ntptr(n)
c pointer to note in R array
 
 c check for chord
        nx=np
4       if(r(1,nx+1).ne.1.)go to 3
c next not a note, hence no chord
        if(r(7,nx+1).ne.0.)go to 3
c has rhythm, not a chord
        nx=nx+1
c go back for more chord notes
        go to 4
3       h=r(4,nx)
c get note height
        hgt=h
        grc=0.
        if(abs(h).lt.100.)return
c found grace note
        grc=1.
        hh=100.
        if(h.lt.0.)hh=-hh
        hgt=h-hh
        end


**** next could be inside of BEAMIN
        subroutine bmpts(n1,n2,m)
c n1,n2 point to start and end of this beam (ntptr array)
c jtail holds how many tails on each note in beam area
        common /dpymem/R(15,150),rpos(2,100),POSNT(150),RHY(100)
     1 ,jstdir(150),ntptr(150)
 
c use rpos and posnt areas??? for jbmnt(m), jtail(m)
        m=0
        do 1 k=n1,n2
        m=m+1
        l=ntptr(k)
        jtail(m)=amod(r(9,l),10.)
1       jbmnt(m)=l
        end